home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 2 / AACD 2.iso / AACD / Programming / fpc / demos / talk2boopsi.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1998-09-22  |  4.2 KB  |  132 lines
  1. PROGRAM Talk2Boopsi;
  2.  
  3. { This example creates a Boopsi prop gadget and integer string gadget, connecting them so they }
  4. { update each other when the user changes their value.  The example program only initializes   }
  5. { the gadgets and puts them on the window; it doesn't have to interact with them to make them  }
  6. { talk to each other.                                                                          }
  7.  
  8. uses Exec, Intuition, Utility;
  9.  
  10. {$I tagutils.inc}
  11.  
  12. VAR
  13.    w      : pWindow;
  14.    mymsg  : pIntuiMessage;
  15.    prop,
  16.    int    : pGadget;
  17.    done   : BOOLEAN;
  18.    dummy  : Word;
  19.    temp   : Longint;
  20.    thetags : array[0..11] of tTagItem;
  21.    prop2intmap : array[0..1] of tTagItem;
  22.    int2propmap : array[0..1] of tTagItem;
  23.  
  24. CONST
  25.  
  26.    vers  : PChar = '$VER: Talk2boopsi 37.1';
  27.  
  28.     PROPGADGET_ID       = 1;
  29.    INTGADGET_ID        = 2;
  30.    PROPGADGETWIDTH     = 10;
  31.    PROPGADGETHEIGHT    = 80;
  32.    INTGADGETHEIGHT     = 18;
  33.    VISIBLE             = 10;
  34.    TOTAL               = 100;
  35.    INITIALVAL          = 25;
  36.    MINWINDOWWIDTH      = 80;
  37.    MINWINDOWHEIGHT     = (PROPGADGETHEIGHT + 70);
  38.    MAXCHARS            = 3;
  39.  
  40. PROCEDURE CleanUp(Why : STRING; err: Word);
  41. BEGIN
  42.     IF prop <> NIL THEN DisposeObject(prop);
  43.     IF int <> NIL THEN DisposeObject(int);
  44.     IF w <> NIL THEN CloseWindow(w);
  45.     IF Why <> '' THEN WriteLN(Why);
  46.     Halt(err);
  47. END;
  48.  
  49. BEGIN
  50.  
  51.     done := FALSE;
  52.  
  53.     prop2intmap[0] := TagItem(PGA_Top, STRINGA_LongVal);
  54.     prop2intmap[1].ti_Tag := TAG_END;
  55.  
  56.     int2propmap[0] := TagItem(STRINGA_LongVal, PGA_Top);
  57.     int2propmap[1].ti_Tag := TAG_END;
  58.  
  59.     thetags[0] := TagItem(WA_Flags,     WFLG_DEPTHGADGET + WFLG_DRAGBAR +
  60.                                WFLG_CLOSEGADGET + WFLG_SIZEGADGET + WFLG_ACTIVATE);
  61.     thetags[1] := TagItem(WA_IDCMP,     IDCMP_CLOSEWINDOW);
  62.     thetags[2] := TagItem(WA_Width,     MINWINDOWWIDTH + 10);
  63.     thetags[3] := TagItem(WA_Height,    MINWINDOWHEIGHT + 10);
  64.     thetags[4] := TagItem(WA_MinWidth,  MINWINDOWWIDTH);
  65.     thetags[5] := TagItem(WA_MinHeight, MINWINDOWHEIGHT);
  66.     thetags[6].ti_Tag := TAG_END;
  67.  
  68.     w := OpenWindowTagList(NIL,@thetags);
  69.  
  70.     IF w=NIL THEN CleanUp('No window',20);
  71.  
  72.     thetags[0] := TagItem(GA_ID,       PROPGADGET_ID);
  73.     thetags[1] := TagItem(GA_Top,      (w^.BorderTop) + 5);
  74.     thetags[2] := TagItem(GA_Left,     (w^.BorderLeft) + 5);
  75.     thetags[3] := TagItem(GA_Width,    PROPGADGETWIDTH);
  76.     thetags[4] := TagItem(GA_Height,   PROPGADGETHEIGHT);
  77.     thetags[5] := TagItem(ICA_MAP,     Longint(@prop2intmap));
  78.     thetags[6] := TagItem(PGA_Total,   TOTAL);
  79.     thetags[7] := TagItem(PGA_Top,     INITIALVAL);
  80.     thetags[8] := TagItem(PGA_Visible, VISIBLE);
  81.     thetags[9] := TagItem(PGA_NewLook, 1); { true }
  82.     thetags[10].ti_Tag := TAG_END;
  83.  
  84.     prop := NewObjectA(NIL, PChar('propgclass'#0),@thetags);
  85.  
  86.     IF prop = NIL THEN CleanUp('No propgadget',20);
  87.  
  88.  
  89.     thetags[0] := TagItem(GA_ID,      INTGADGET_ID);
  90.     thetags[2] := TagItem(GA_Top,     (w^.BorderTop) + 5);
  91.     thetags[3] := TagItem(GA_Left,    (w^.BorderLeft) + PROPGADGETWIDTH + 10);
  92.     thetags[4] := TagItem(GA_Width,   MINWINDOWWIDTH -
  93.                                   (w^.BorderLeft + w^.BorderRight +
  94.                                   PROPGADGETWIDTH + 15));
  95.     thetags[5] := TagItem(GA_Height,  INTGADGETHEIGHT);
  96.  
  97.     thetags[6] := TagItem(ICA_MAP,    Longint(@int2propmap));
  98.     thetags[7] := TagItem(ICA_TARGET, Longint(prop));
  99.     thetags[8] := TagItem(GA_Previous, Longint(prop));
  100.  
  101.     thetags[9] := TagItem(STRINGA_LongVal,  INITIALVAL);
  102.     thetags[10] := TagItem(STRINGA_MaxChars, MAXCHARS);
  103.     thetags[11].ti_Tag := TAG_END;
  104.  
  105.     int := NewObjectA(NIL, PChar('strgclass'#0),@thetags);
  106.  
  107.     thetags[0] := TagItem(ICA_TARGET, Longint(int));
  108.     thetags[1].ti_Tag := TAG_END;
  109.  
  110.     temp := SetGadgetAttrsA(prop, w, NIL,@thetags);
  111.  
  112.     IF int = NIL THEN CleanUp('No INTEGER gadget',20);
  113.  
  114.     dummy := AddGList(w, prop, -1, -1, NIL);
  115.     RefreshGList(prop, w, NIL, -1);
  116.  
  117.     WHILE (NOT done) DO BEGIN
  118.         mymsg := pIntuiMessage(WaitPort(W^.UserPort));
  119.         mymsg := pIntuiMessage(GetMsg(W^.UserPort));
  120.         IF mymsg^.IClass = IDCMP_CLOSEWINDOW THEN done := True;
  121.         ReplyMsg(pMessage(mymsg));
  122.     END;
  123.  
  124.     dummy := RemoveGList(w, prop, -1);
  125.     CleanUp('',0);
  126. END.
  127.  
  128.  
  129.  
  130.  
  131.  
  132.